home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / text / misc / texinfo216.lzh / elisp / makeinfo.el < prev    next >
Lisp/Scheme  |  1992-03-26  |  12KB  |  327 lines
  1. ;;;; makeinfo.el
  2.  
  3. ;;;  Texinfo mode interface to the `makeinfo' command
  4. ;;;  for converting part or all of a Texinfo file to an Info file.
  5.  
  6. ;;; Version 2.04   12 February 1992
  7. ;;; Robert J. Chassell      
  8.  
  9. ;;; Copyright (C) 1991 Free Software Foundation, Inc.
  10.  
  11.  
  12. ;;; This file is part of GNU Emacs.
  13.  
  14. ;; GNU Emacs is free software; you can redistribute it and/or modify
  15. ;; it under the terms of the GNU General Public License as published by
  16. ;; the Free Software Foundation; either version 1, or (at your option)
  17. ;; any later version.
  18.  
  19. ;; GNU Emacs is distributed in the hope that it will be useful,
  20. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22. ;; GNU General Public License for more details.
  23.  
  24. ;; You should have received a copy of the GNU General Public License
  25. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  26. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  27.  
  28.  
  29. ;;; The Texinfo mode `makeinfo' related commands are:
  30.  
  31. ;; makeinfo-region      to run makeinfo on the current region.
  32. ;; makeinfo-buffer      to run makeinfo on the current buffer, or
  33. ;;                        with optional prefix arg, on current region
  34. ;; kill-compilation     to kill currently running makeinfo job
  35. ;; makeinfo-recenter-makeinfo-buffer  to redisplay *compilation* buffer
  36.  
  37.  
  38. ;;; Keybindings (defined in `texinfo.el')
  39.  
  40. ;; makeinfo bindings
  41. ; (define-key texinfo-mode-map "\C-c\C-m\C-r" 'makeinfo-region)
  42. ; (define-key texinfo-mode-map "\C-c\C-m\C-b" 'makeinfo-buffer)
  43. ; (define-key texinfo-mode-map "\C-c\C-m\C-k" 'kill-compilation)
  44. ; (define-key texinfo-mode-map "\C-c\C-m\C-l"
  45. ;   'makeinfo-recenter-compilation-buffer)
  46.  
  47.  
  48. ;;; Variables used by `makeinfo'
  49.  
  50. (require 'compile)
  51.  
  52. (defvar makeinfo-run-command "makeinfo"
  53.   "*Command used to run makeinfo subjob.
  54. The name of the file will be appended to this string, separated by a space.")
  55.  
  56. (defvar makeinfo-options "+fill-column=70"
  57.   "*String containing flags for  makeinfo.  
  58. Do not include footnote-style or paragraph-indent, which are specified
  59. by @footnotestyle and @paragraphindent.")
  60.  
  61. (require 'texinfo)
  62. (require 'texinfmt)
  63.  
  64. (defvar makeinfo-compilation-process nil
  65.   "Process that runs makeinfo. Should start out nil.")
  66.  
  67. (defvar makeinfo-temp-file nil
  68.   "Temporary file name used for text being sent as input to makeinfo.")
  69.  
  70. (defvar makeinfo-output-file-name nil
  71.   "Info file name used for text output by makeinfo.")
  72.  
  73.  
  74. ;;; The `makeinfo' function definitions
  75.  
  76. (autoload 'compile1 "compile")
  77.  
  78. (defun makeinfo-region (region-beginning region-end)
  79.   "Make Info file from region of current Texinfo file, and switch to it.
  80.  
  81. This command does not offer the `next-error' feature since it would
  82. apply to a temporary file, not the original; use the `makeinfo-buffer'
  83. command to gain use of `next-error'."
  84.   
  85.   (interactive "r")
  86.   (let (filename-or-header
  87.         filename-or-header-beginning
  88.         filename-or-header-end)
  89.     ;; Cannot use `let' for makeinfo-temp-file or
  90.     ;; makeinfo-output-file-name since `makeinfo-compilation-sentinel'
  91.     ;; needs them.
  92.  
  93.     (setq makeinfo-temp-file
  94.           (concat
  95.            (make-temp-name
  96.             (substring (buffer-file-name)
  97.                        0 
  98.                        (or (string-match "\\.tex" (buffer-file-name)) 
  99.                            (length (buffer-file-name)))))
  100.            ".texinfo"))
  101.     
  102.     (save-excursion
  103.       (save-restriction
  104.         (widen)
  105.         (goto-char (point-min))
  106.         (let ((search-end (save-excursion (forward-line 100) (point))))
  107.           ;; Find and record the Info filename,
  108.           ;; or else explain that a filename is needed.
  109.           (if (re-search-forward 
  110.                "^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*"
  111.                search-end t)
  112.               (setq makeinfo-output-file-name 
  113.                     (buffer-substring (match-beginning 1) (match-end 1)))
  114.             (error
  115.              "The texinfo file needs a line saying: @setfilename <name>"))
  116.  
  117.           ;; Find header and specify its beginning and end.
  118.           (goto-char (point-min))
  119.           (if (and 
  120.                (prog1 
  121.                    (search-forward texinfo-start-of-header search-end t)
  122.                  (beginning-of-line)
  123.                  ;; Mark beginning of header.
  124.                  (setq filename-or-header-beginning (point)))
  125.                (prog1 
  126.                    (search-forward texinfo-end-of-header nil t)
  127.                  (beginning-of-line)
  128.                  ;; Mark end of header
  129.                  (setq filename-or-header-end (point))))
  130.               
  131.               ;; Insert the header into the temporary file.
  132.               (write-region
  133.                (min filename-or-header-beginning region-beginning)
  134.                filename-or-header-end
  135.                makeinfo-temp-file nil nil)
  136.             
  137.             ;; Else no header; insert @filename line into temporary file.
  138.             (goto-char (point-min))
  139.             (search-forward "@setfilename" search-end t)
  140.             (beginning-of-line)
  141.             (setq filename-or-header-beginning (point))
  142.             (forward-line 1)
  143.             (setq filename-or-header-end (point))
  144.             (write-region
  145.              (min filename-or-header-beginning region-beginning)
  146.              filename-or-header-end
  147.              makeinfo-temp-file nil nil))
  148.           
  149.           ;; Insert the region into the file.
  150.           (write-region
  151.            (max region-beginning filename-or-header-end)
  152.            region-end
  153.            makeinfo-temp-file t nil)
  154.  
  155.           ;; Run the `makeinfo-compile' command in the *compilation* buffer
  156.           (save-excursion
  157.             (makeinfo-compile
  158.              (concat makeinfo-run-command
  159.                      " "
  160.                      makeinfo-options
  161.                      " " 
  162.                      makeinfo-temp-file)
  163.              "Use `makeinfo-buffer' to gain use of the `next-error' command.")))))))
  164.  
  165. ;; Based on `compile1' in compile.el; changed so to make it possible
  166. ;; to delete temporary file.
  167. (defun makeinfo-compile (command error-message &optional name-of-mode)
  168.   ;(save-some-buffers)                   ; Don't need to save other buffers.
  169.   (if makeinfo-compilation-process
  170.       (if (or (not (eq (process-status makeinfo-compilation-process) 'run))
  171.           (yes-or-no-p
  172.                "A `makeinfo' compilation process is running; kill it? "))
  173.       (condition-case ()
  174.           (let ((comp-proc makeinfo-compilation-process))
  175.         (interrupt-process comp-proc)
  176.         (sit-for 1)
  177.         (delete-process comp-proc))
  178.         (error nil))
  179.     (error "Cannot have two makeinfo processes")))
  180.   (setq makeinfo-compilation-process nil)
  181.   (compilation-forget-errors)
  182.   (setq compilation-error-list t)
  183.   (setq compilation-error-message error-message)
  184.   (setq makeinfo-compilation-process
  185.     (start-process "makeinfo" "*compilation*"         
  186.                shell-file-name
  187.                "-c" (concat "exec " command)))
  188.   (with-output-to-temp-buffer "*compilation*"             
  189.     (princ "cd ")
  190.     (princ default-directory)
  191.     (terpri)
  192.     (princ command)
  193.     (terpri))
  194.   (let ((regexp compilation-error-regexp))
  195.     (save-excursion
  196.       (set-buffer "*compilation*")                        
  197.       (make-local-variable 'compilation-error-regexp)
  198.       (setq compilation-error-regexp regexp)))
  199.   (set-process-sentinel
  200.    makeinfo-compilation-process 'makeinfo-compilation-sentinel)
  201.   (let* ((thisdir default-directory)
  202.      (outbuf (process-buffer makeinfo-compilation-process))
  203.      (outwin (get-buffer-window outbuf)))
  204.     (if (eq outbuf (current-buffer))
  205.     (goto-char (point-max)))
  206.     (save-excursion
  207.       (set-buffer outbuf)
  208.       (buffer-flush-undo outbuf)
  209.       (let ((start (save-excursion (set-buffer outbuf) (point-min))))
  210.     (set-window-start outwin start)
  211.     (or (eq outwin (selected-window))
  212.         (set-window-point outwin start)))
  213.       (setq default-directory thisdir)
  214.       (fundamental-mode)
  215.       (setq mode-name (or name-of-mode "compilation"))    
  216.       ;; Make log buffer's mode line show process state
  217.       (setq mode-line-process '(": %s")))))
  218.  
  219. ;; Delete makeinfo-temp-file after proccessing is finished,
  220. ;; and visit Info file.
  221. ;; This function is called when the compilation process changes state.
  222. ;; Based on `compilation-sentinel' in compile.el
  223. (defun makeinfo-compilation-sentinel (proc msg)
  224.   (cond ((null (buffer-name (process-buffer proc)))
  225.      ;; buffer killed
  226.      (set-process-buffer proc nil))
  227.     ((memq (process-status proc) '(signal exit))
  228.      (let* ((obuf (current-buffer))
  229.         omax opoint)
  230.        ;; save-excursion isn't the right thing if
  231.        ;;  process-buffer is current-buffer
  232.        (unwind-protect
  233.            (progn
  234.          ;; Write something in *compilation* and hack
  235.          ;; its mode line,
  236.          (set-buffer (process-buffer proc))
  237.          (setq omax (point-max) opoint (point))
  238.          (goto-char (point-max))
  239.          (insert ?\n mode-name " " msg)
  240.          (forward-char -1)
  241.          (insert " at "
  242.              (substring (current-time-string) 0 -5))
  243.          (forward-char 1)
  244.          (setq mode-line-process
  245.                (concat ": "
  246.                    (symbol-name (process-status proc))))
  247.          ;; If buffer and mode line will show that the process
  248.          ;; is dead, we can delete it now.  Otherwise it
  249.          ;; will stay around until M-x list-processes.
  250.          (delete-process proc))
  251.          (setq makeinfo-compilation-process nil)
  252.          ;; Force mode line redisplay soon
  253.          (set-buffer-modified-p (buffer-modified-p)))
  254.        (if (and opoint (< opoint omax))
  255.            (goto-char opoint))
  256.        (set-buffer obuf))
  257.          (if (and makeinfo-temp-file (file-exists-p makeinfo-temp-file))
  258.              (delete-file makeinfo-temp-file))
  259.          ;; Always use the version on disk.
  260.          (if (get-file-buffer makeinfo-output-file-name)
  261.              (progn (set-buffer makeinfo-output-file-name)
  262.                     (revert-buffer t t)))
  263.          (find-file makeinfo-output-file-name)
  264.          (goto-char (point-min)))))
  265.  
  266. (defun makeinfo-buffer (buffer)
  267.   "Make Info file from current buffer.
  268.  
  269. The \\[next-error] command can be used to move to the next error 
  270. \(if any are found\)."
  271.   
  272.   (interactive "bRun `makeinfo' on: ")
  273.   (cond ((null buffer-file-name)
  274.          (error "Buffer not visiting any file!"))
  275.         ((buffer-modified-p)
  276.          (if (y-or-n-p "Buffer modified; do you want to save it? ")
  277.              (save-buffer))))
  278.   
  279.   ;; Find and record the Info filename,
  280.   ;; or else explain that a filename is needed.
  281.   (save-excursion
  282.     (goto-char (point-min))
  283.     (let ((search-end (save-excursion (forward-line 100) (point))))
  284.       (if (re-search-forward 
  285.            "^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*"
  286.            search-end t)
  287.           (setq makeinfo-output-file-name 
  288.                 (buffer-substring (match-beginning 1) (match-end 1)))
  289.         (error
  290.          "The texinfo file needs a line saying: @setfilename <name>"))))
  291.   
  292.   (save-excursion
  293.     (makeinfo-compile
  294.      (concat makeinfo-run-command
  295.              " " 
  296.              makeinfo-options
  297.              " " 
  298.              "+footnote-style="
  299.              texinfo-footnote-style
  300.              " "
  301.              (buffer-file-name
  302.               (get-buffer buffer)))
  303.      "No more errors.")))
  304.  
  305. (defun makeinfo-recenter-compilation-buffer (linenum)
  306.   "Redisplay *compilation* buffer so that most recent output can be seen.
  307. The last line of the buffer is displayed on
  308. line LINE of the window, or centered if LINE is nil."
  309.   (interactive "P")
  310.   (let ((makeinfo-buffer (get-buffer "*compilation*"))
  311.     (old-buffer (current-buffer)))
  312.     (if (null makeinfo-buffer)
  313.     (message "No *compilation* buffer")
  314.       (pop-to-buffer makeinfo-buffer)
  315.       (bury-buffer makeinfo-buffer)
  316.       (goto-char (point-max))
  317.       (recenter (if linenum
  318.             (prefix-numeric-value linenum)
  319.           (/ (window-height) 2)))
  320.       (pop-to-buffer old-buffer)
  321.       )))
  322.  
  323.  
  324. ;;; Place `provide' at end of file.
  325. (provide 'makeinfo)
  326. ;;;;;;;;;;;;;;;; end makeinfo.el ;;;;;;;;;;;;;;;;
  327.